perm filename XAP1.NEW[XAP,BGB]2 blob
sn#053601 filedate 1973-07-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00015 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00015 PAGES
C00003 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00007 00003 FONT SPECIFICATION.
C00008 00004 XGP RASTER PAGE BUFFER.
C00010 00005 ALTERNATE PDP-10 MNEMONICS.
C00015 00006 START ADDRESS ENTRY.
C00017 00007 SUBR(BEGPROG) BEGIN PROGRAM.
C00019 00008 SUBR(PASS1)
C00020 00009 SUBR(PASS2)
C00023 00010 HTAB: LAC COL↔SUB LMAR TEXT HORIZONTAL TAB.
C00024 00011 SUBR(MKTABL) MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
C00028 00012 SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00031 00013 SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00034 00014 SUBR TEXT
C00041 00015 SUBR LBLINE
C00046 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
;JOB DATA AREA AND CORE MAP.
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PDLLEN←←.-PDL
PAT: BLOCK 100 ;PATCH AREA.
LINBUF: BLOCK 100 ;Line buffer for justification
LINLEN←←.-LINBUF
EXTERN JOBJDA ;140 END OF JOB DATA AREA.
EXTERN JOBFF ;121 TOP OF USED CORE POINTER.
EXTERN JOBSA ;120 XWD ORGINAL-TOP,START-ADDR.
EXTERN JOBREL ; 44 PHYSICAL TOP OF CORE IMAGE.
;PROCESSOR STATUS.
PASS:0 ;0 FOR PASS1, -1 FOR PASS2.
PMODE:0 ;PAGINATION MODE: 0 MANUAL, -1 AUTOMATIC.
WFMODE:0 ;WINDOW FILLING MODE: 0 TEXT, -1 GRAPHICS, +1 XGP.
CMODE:0 ;-1 COMMAND MODE. 0 TEXT MODE.
CHAR:0 ;CURRENT CHARACTER.
CHRCNT:0 ;CHARACTERS REMAINING.
TXTPTR:0 ;TEXT POINTER.
TXTORG:0 ;TEXT ORIGIN.
TXTEND:0
XLINE:2 ;EXTRA LINES BETWEEN ROWS OF CHARACTERS
EOF:0↔HIDDEN:0
BUGFLG:-1;0 ;-1 WHEN DEBUGGING.
;DSK I/O DATA AREA.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
RPGFLG: 0
;TEXT JUSTFICATION MODES:
$AUTOCR←←-1
$CLIP←← 0
$BOTH←← 1
$RIGHT←← 2
$CENTER←← 3
$LEFT←← 4
TJMODE: 1;(THE HARD ONE) ;Current text justification mode
TJPTR: BLOCK 1 ;Byte pointer to end of buffer-1.
TJCNT: BLOCK 1 ;Number of characters remaining in buffer.
TJHEIGHT: BLOCK 1 ;Maximum height.
TJDEPTH: BLOCK 1 ;Maximum depth.
TJODEPTH: BLOCK 1 ;Old maximum depth.
TJFONT: BLOCK 1 ;Last font selected when TEXT was called.
TJSPTR: BLOCK 1 ;Pointer to last space in line buffer.
TJSCNT: BLOCK 1 ;Number of spaces in line buffer.
TJSPOS: BLOCK 1 ;Column where last space begins
TJLMAR: BLOCK 1 ;Left margin for text justification.
TJRMAR: BLOCK 1 ;Right margin for text justification.
LFFLAG: BLOCK 1 ;Line feed has been seen but not processed.
CRFLAG: BLOCK 1 ;Return has been seen but not processed.
SAVTPC: BLOCK 1 ;For the quarter page kludge
;FONT SPECIFICATION.
FONT: 1
FONTAB: BLOCK =45
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
FNTNAM: 0 ;DEFAULT FONT NAMES.
SIXBIT/LPT/ ;1 LINE PRINTER.
SIXBIT/FIX13X/ ;2 FIXED WIDTH FONTS.
SIXBIT/FIX20/ ;3
SIXBIT/FIX25/ ;4
SIXBIT/FIX40/ ;5
SIXBIT/NGR13/ ;6 NEW GOTHIC ROMAN.
SIXBIT/NGR20/ ;7
SIXBIT/NGR25/ ;8
SIXBIT/NGR30/ ;9
SIXBIT/NGR40/ ;A
SIXBIT/BDR25/ ;B BODONI ROMAN
SIXBIT/BDI25/ ;C BODONI ITALIC
SIXBIT/BDR40/ ;D
SIXBIT/XMAS25/ ;E PSEUDO OLDE ENGLISH.
SIXBIT/SIGN57/ ;F
SIXBIT/GRK25/ ;G GREEK.
SIXBIT/SET1/ ;H TOVAR'S CREATION.
;XGP RASTER PAGE BUFFER.
ROW:0 ;XGP "PEN" POSITION.
COL:0
DROW:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
DCOL:0
QPAGE:0 ;QUARTER PAGE: 0, 1, 2, 3.
QLO:0↔QHI:0 ;QUARTER ROW LOW & QUARTER ROW HI.
ORGXGP:0 ;XGP BUFFER (1/4 OF A PAGE).
ENDXGP:0
;XGP RASTER DIMENSIONS.
WWIDTH←←=49 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1728.
MROWS←←=2048 ;NUMBER OF ROWS IS 2048.
BUFSIZ←←WWIDTH*MROWS/4 ;SIZE OF XGP BUFFER (ONE QUARTER PAGE).
;III BUFFER DISPLAY.
IIIDX: =1024
IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
RMAR:NCOLS
LMAR:=200
ROWMIN:=200
ROWMAX:MROWS
;GRAPHICS WINDOW.
GWROWS:0 ;RASTER SIZE.
GWCOLS:0
GWROW0:0 ;RASTER ORIGIN.
GWCOL0:0
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM
;SAIL LIKE SUBROUTINE LINKAGE.
↓P←←17
DEFINE SUBR(NAME){INTERN NAME↔↓NAME: ;}
; DEFINE CALL(NAME,X1,X2,X3,X4){
; IFDIF<><X1>{PUSH 17,X1↔IFDIF<><X2>{PUSH 17,X2
; IFDIF<><X3>{PUSH 17,X3↔IFDIF<><X4>{PUSH 17,X4}}}}
; PUSHJ 17,NAME}
DEFINE CAT $(A,B){A$B}
;SUBROUTINE DECLARATIONS. MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
.PLEVEL←←0
.SLEVEL←←0
DEFINE NSUBR(NAME,X1,X2,X3,X4,X5)
{ BEGIN NAME
INTERN NAME
GLOBAL .PLEVEL
GLOBAL .SLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
.PLEVEL←.PLEVEL+1
}}}}}
XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
↓NAME: ;}
;DEFINE AN ARGUMENT
DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}
;END OF SUBROUTINE
DEFINE SUBREND
{ .PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
LIT
BLOCK 0
BEND }
;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{ GLOBAL .SLEVEL,.PLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
}}}}}
IFDIF <><NAME>{
PUSHJ P,NAME
}
.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
}
;PUSH SOMETHING ONTO STACK
DEFINE PUSHP(ARG)
< PUSH P,ARG
.PLEVEL←←.PLEVEL+1
>
DEFINE POPP(ARG)
< POP P,ARG
.PLEVEL←←.PLEVEL-1
>
DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;START ADDRESS ENTRY.
SA: TDCA↔SETA↔DAC RPGFLG↔CALLI ;SET RPG FLAG.
CAR JOBSA↔DAC JOBFF↔CORE↔JFCL ;CORE DOWN LOWER.
LACI =2047↔CORE2↔GO[
FATAL(<CAN'T GET A 2ND SEGMENT.>)]
LAC P,[IOWD PDLLEN,PDL] ;INITIALIZE TABLES
CALL DOCINIT ;INITIALIZE DATA STRUCTURE
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
SKIPE RPGFLG↔JFCL ;RPG INITIALIZATION.
CALL(BEGPROG) ;PROGRAM INITIALIZATION.
;TWO PASS XEROX TEXT ASSEMBLER.
CALL(PASS1)
CALL(PASS2)
;END PROGRAM.
CALLI 0 ;FLUSH LIBRASCOPE.
LAC JOBFF↔CORE↔JFCL ;FLUSH CORE.
SETZ↔CORE2↔JFCL ;FLUSH UPPER SEGMENT.
EXIT
;____________________________________________________________________
SUBR(BEGPROG) ;BEGIN PROGRAM.
BEGIN BEGPROG
LACI 0↔UFBGET↔GO .+3
LACI 1↔UFBGET↔GO[FATAL(<CAN'T GET FASTBANDS.>)]
;DEFAULT INITIALIZE MARGINS.
LAC ROWMIN↔DAC ROW
LACI MROWS-=100↔DAC ROWMAX
LAC LMAR↔DAC LMAR↔DAC COL
LACI NCOLS↔DAC RMAR
;INITIALIZE SCANNER AND CORE ALLOCATION.
SETOM CMODE ;COMMAND MODE.
CALL(MKBUF) ;MAKE XGP BUFFER.
CALL(MKTABL) ;MAKE 2D BIT ADDRESS TABLE.
;DEFINE DEFAULT FONT.
SETZM FONTAB
LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
LAC[SIXBIT/LPTFNT/]
HLLZM FILNAM↔DIPZ EXTION
LAC FNTPPN↔DAC PPPN
LACI 1↔DAC FONT
CALL(<DEFONT+1>)
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
RESCAN↔INCHSL↔EXIT↔CAIN 15↔EXIT
CAIE";"↔GO .-5↔DZM CHRCNT
CDR JOBFF↔LIPI 440700
DAC TXTPTR↔DAC TXTORG
INCHSL 1↔EXIT
CAIN 1,"D"↔SETOM BUGFLG↔GO .+3
INCHSL 1↔GO .+4↔AOS CHRCNT
IDPB 1,0↔GO .-4↔DAC TXTEND
SKIPN BUGFLG↔POP0J
OUTSTR[ASCIZ/BEGIN./]↔INCHRW↔CRLF↔POP0J
BEND BEGPROG;________________________________________________________
SUBR(PASS1)
BEGIN PASS1
LAC TXTORG↔DAC TXTPTR
CDR 1,TXTEND↔CDR 0,TXTORG
SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
L1: SETQ(CHAR,{GETCHR})
SKIPGE CHRCNT↔GO L3
SKIPE CMODE↔GO L2
;TEXT MODE CHARACTER.
CAR A00(1)
CAIN 1,"~"↔SETOM CMODE
; SKIPE↔PUSHJ P,@0
GO L1
;COMMAND MODE CHARACTER.
L2: CDR A00(1)
CAIN 1,"F"↔GO[CALL(GETCHR)↔SETZM CMODE↔GO L1]
CAIN 1,"@"↔PUSHJ P,@0
GO L1
;END OF DOCUMENT.
L3: SETOM CMODE
POP0J
BEND PASS1;__________________________________________________________
SUBR(PASS2)
BEGIN PASS2
;START-OF-DOCUMENT.
LAC TXTORG↔DAC TXTPG#↔DZM EOF
CDR 1,TXTEND↔CDR 0,TXTORG
SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
LAC CHRCNT↔DAC SAVCNT#↔SETZM SAVTPC
;START-OF-PAGE.
L0: LACI =511↔DAC QHI↔DZM QLO↔DZM QPAGE ;1ST QUARTER PAGE.
L00: LAC TXTPG↔DAC TXTPTR ;TOP-OF-THE-PAGE.
LAC SAVTPC↔DAC TEXTPC
LAC SAVCNT↔DAC CHRCNT
LAC ROWMIN↔DAC ROW
;START-OF-QUARTER-PAGE.
LAC ORGXGP↔DZM@↔DIP↔AOS↔BLT@ENDXGP ;CLEAR QUARTER PAGE.
LAC [SIXBIT/TEXT/]↔DAC ANAME ;SET DEFAULT AREA
CALL(NXTPAGE)
SETZM TJODEPTH
SETZM TJPTR
SKIPN BUGFLG↔GO L1
OUTSTR[ASCIZ/QUARTER /]
LAC QPAGE↔IORI"0"↔OUTCHR↔CRLF
;PROCESS A CHARACTER.
L1: SETQ(CHAR,{GETCHR})
SKIPGE CHRCNT↔GO L3 ;END OF DOCUMENT.
JUMPE 1,L1
CAIN 1,14↔GO L3 ;FORM FEED.
SKIPE CMODE↔GO L2
CAIN 1,"~"↔GO [ SETOM CMODE↔GO L1 ]
CALL TEXT↔GO L1 ;TEXT MODE CHARACTER.
L2: CDR A00(1) ;COMMAND MODE CHARACTER.
SKIPE↔PUSHJ P,@0↔GO L1
;WRITE QUARTER-PAGE ON FAST BAND.
L3: LAC 1,QPAGE
LAC[0↔=784↔=1568↔0](1)↔DAC SECTOR
LAC ORGXGP↔DAC BUFPTR
LACI =25088↔DAC WRDCNT
LAC[0↔0↔0↔1](1)↔DAC BAND
FBWRT BUFPTR↔OUTSTR[ASCIZ/WARNING: FB WRITE ERROR./]
;ADVANCE TO NEXT QUARTER PAGE.
LACI =512↔ADDM QLO↔ADDM QHI
AOS 1,QPAGE↔CAIGE 1,4↔GO L00
;ADVANCE TO NEXT PAGE.
L4: CALL(XGPOUT)
SETOM 0↔TTYUUO 6,0↔CAIN 0,-1↔GO L4A
OUTSTR[ASCIZ/IS THIS PAGE OK ?/]↔INCHRW↔CAIN"N"↔GO L4
L4A: CRLF
LAC TXTPTR↔DAC TXTPG
LAC CHRCNT↔DAC SAVCNT
LAC TEXTPC↔DAC SAVTPC
SKIPN EOF↔GO L0
POP0J
BEND PASS2;__________________________________________________________
HTAB: LAC COL↔SUB LMAR ;TEXT HORIZONTAL TAB.
LAC 16,DCOL↔SUBI 16,2 ;KLUDGE TO MAKE CRE DOCUMENT.
IDIV 16↔ANDCMI 7
ADDI 8↔IMUL 16↔ADD LMAR
DAC COL
POP0J
CRETURN:LAC LMAR ;TEXT CARRIAGE RETURN.
DAC COL
POP0J
LFEED: LAC DROW ;TEXT LINE FEED.
ADDM ROW
GO ROWCHK
SPACE: LAC DCOL↔ADDM COL
↑COLCHK:LAC COL↔CAMG RMAR↔GO ROWCHK ;COLUMN OVERFLOW - DEFAULT CRLF.
LAC LMAR↔DAC COL
LAC DROW↔ADDM ROW
↑ROWCHK:LAC ROW↔CAMGE ROWMAX↔POP0J ;ROW OVERFLOW - Fetch next window
CALL NXTWINDOW↔POP0J
FFEED: SKIPA↔CALL(XGPOUT) ;FORM FEED.
LAC ROWMIN↔DAC ROW
LAC LMAR↔DAC COL↔POP0J
ESCAPE: SETOM CMODE↔POP0J
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
The DOT macro places a bit at a given row and column of the
XGP buffer. The 2D bit address byte pointer is computed by twice
referencing a 2K table in which the Nth word contains the bytes
0:5(N div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).
That is the left halfword of the Nth table entry contains the base
address of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column. In the DOT macro,
the HLLZ and ROT instructions setup the column byte pointer and the
HRRI instruction (thru the magic of immediate indirect double
indexing) adds the right halfword of the Nth row table entry to the
byte pointer. The use of accumulator 1 is mandatory because of the
index-byte-size pun. The following subroutine initializes the table.⊗
BEGIN MKTABL;________________________________________________________
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔AOS↔TLO 4301↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=512,% ;2 AOBJN TABLE POINTER.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
BEND MKTABL;BGB 24 MAY 1973._________________________________________
SUBR(MKBUF) MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
BEGIN MKBUF;------------------------------------------------------
;EXPAND CORE FOR XGP BUFFER.
CDR JOBFF↔DAC ORGXGP
ADDI BUFSIZ-1↔DAC ENDXGP
ADDI 3*WWIDTH+10↔DAC JOBFF↔ADDI =3000
CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@JOBREL
POP0J
BEND MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
BEGIN XGPOUT;-----------------------------------------------------
BSIZ ←← =6272 ↔ BCNT ←← =16 ;BUFFER SIZE & NUMBER OF THEM.
SETZ 1,↔SEGNUM 1,↔DAC 1,MYSEG#↔DETSEG↔;LOCK;DETACH SEGMENT.
OUTSTR[ASCIZ/PAGE TO XGP.../]
LAC ORGXGP↔DAC BUFORG↔ADDI 3*BSIZ↔DAC BUFEND
CAMLE JOBREL↔CORE↔JFCL
DZM BAND↔DZM SECTOR↔LAC BUFORG↔DAC BUFPTR
;XGP OUTPUT ONE PAGE.
INIT 2,117↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK↔LACI 3,BCNT ;THIS MANY DRUM BUFFERS PER PAGE.
;READ DRUM.
L1: LACI BSIZ↔DAC WRDCNT↔LAC BAND
FBREAD BUFPTR↔OUTSTR[ASCIZ/FAST BAND READ ERROR. /]
LACI =196↔ADDB SECTOR↔CAIG =2156↔GO .+3↔DZM SECTOR↔AOS BAND
;PUT XGP CONTROL WORD IN EACH ROW.
LAC[1B11+=48]↔LAC 1,BUFPTR↔LACI 2,=128
DAC(1)↔ADDI 1,=49↔SOJG 2,.-2
CAIE 3,BCNT↔GO L2
OUT 2,CUTARG↔SKIPA↔JFCL
;PRINT ON XGP.
L2: SLACI -BSIZ↔LAP BUFPTR↔SOS↔ASH 3,1↔DAC DUMARG(3)
OUT 2,DUMARG(3)↔SKIPA↔OUTSTR[ASCIZ/XGP ERROR /]↔ASH 3,-1
CAIE 3,1↔GO L3
OUT 2,CUTARG↔SKIPA↔JFCL↔GO L4
;ADVANCE TO NEXT BUFFER.
L3: LACI BSIZ↔ADDB BUFPTR↔CAMGE BUFEND↔GO L4
LAC BUFORG↔DAC BUFPTR
L4: SOJG 3,L1↔UNLOCK↔RELEASE 2,↔OUTSTR[ASCIZ/FINISHED./]↔CRLF
LAC 1,MYSEG↔JUMPE 1,.+3 ;RE-ATTACH SEGMENT.
ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
POP0J
;____________________________________________________________________
BUFORG:0↔BUFEND:0 ;XGP BUFFERS.
CUTARG: IOWD 2,HACK↔0
DUMARG:BLOCK BSIZ*2 + 4
HACK: 1B0+=30B11↔0 ;CHOP PAPER.
BEND XGPOUT;BGB 28 MAY 1973.--------------------------------------
BAND:0↔BUFPTR:0↔WRDCNT:=12544↔SECTOR:0 ;FB UUO ARGUMENT.
SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
BEGIN PRINT;------------------------------------------------------
ACCUMULATORS{G,B,B2,M,N,I,X16}
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP0J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,CHAR ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW↔SUB 0,QLO
IMULI WWIDTH
ADD ORGXGP↔DAPZ B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL
SKIPE TJMODE↔GO .+3 ;CLIP LINE OVERFLOW IF TJMODE=0
CAML 0,RMAR↔POP0J
IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
LAC X16,FONT↔CAIN X16,8 ;SPECIAL HACK FOR CRE MANUAL.
GO[LAC X16,DCOL↔SUBI X16,2↔ADDM X16,COL↔GO .+2]
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
LACI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1
POP0J
BEND PRINT;BGB 23 MAY 1973.---------------------------------------
SUBR TEXT
BEGIN TEXT
LAC 1,CHAR
SKIPE TEXTPC
GO @TEXTPC ;Co-routine linkage!
GO NEWPAR
$GETCH: POP P,TEXTPC ;Where to continue co-routine
POP0J ;TEXT is called with a PUSHJ
;Begin a paragraph
NEWPAR: SETOM CRFLAG
CALL LBFLUSH ;Flush any existing text
GO CR3
NXTCHR: CALL $GETCH ;Get a character
GOTCHR: CAR 0,A00(1) ;Special?
JUMPN 0,SPCHAR
PUTCHR: SKIPE TJPTR ;Is line buffer set up?
GO PTROK ;Yes
LAC 0,[POINT 7,LINBUF]
DAC 0,TJPTR ;Setup pointer to end of pointer
SETZM TJHEIGHT ;Clear maximum height for row
SETZM TJDEPTH ;Clear maximum depth for row
LACI 0,5*LINLEN ;Setup character count
DAC 0,TJCNT
LAC 0,COL
DAC 0,TJLMAR ;Left margin for text justification.
LAC 0,RMAR
DAC 0,TJRMAR ;Right margin for text justification,
SETOM TJFONT ;Force initial font select
PTROK: SKIPN TJMODE ;If not clip mode
GO COLOK
LAC 0,COL ;Check column overflow
CAMGE 0,TJRMAR
GO COLOK ;OK
CALL LBLINE ;Put out line
SETOM LFFLAG ;Set flag for line feed
COLOK: LAC 2,FONT ;Check for font change
CAMN 2,TJFONT
GO FONTOK
CAIL 2,20
GO [ FATAL(FONT NUMBER > 15.) ]
LACI 2,177 ;Save number of font
IDPB 2,TJPTR
SOSG TJCNT
CALL LBLOSE
LAC 2,FONT
DAC 2,TJFONT
IDPB 2,TJPTR
SOSG TJCNT
CALL LBLOSE
SKIPN 2,FONTAB(2) ;Make sure the font exists!
CALL NOFONT
LAC 0,203(2) ;Check height
CAMLE 0,TJHEIGHT
DAC 0,TJHEIGHT
LAC 0,201(2) ;Check depth
SUB 0,203(2)
CAMLE 0,TJDEPTH
DAC 0,TJDEPTH
FONTOK: IDPB 1,TJPTR ;Put character into buffer
SOSG TJCNT
CALL LBLOSE
PUSH P,[NXTCHR] ;Fake a return address!
ADVCOL: LAC 2,FONT
SKIPN 2,FONTAB(2) ;Fetch address of font
CALL NOFONT ;Font not there!
ADD 2,1 ;Update column
CAR 0,(2)
ADDM 0,COL
POP0J
;Special characters
SPCHAR: CAIN 1," "
GO [ CALL PUTCHR ;Put space into line buffer
SKIPG TJMODE ;Are we justifying?
GO NXTCHR ;No, just get next character
CALL $GETCH ;Get another character
CAIN 1," " ;Flush multiple spaces (is this really
GO $.-2 ;a good idea?)
GO GOTCHR ] ;Put character into buffer
CAIN 1,15 ;<RETURN>?
GO [ SKIPG TJMODE ;Are we justifying?
GO [ SETOM CRFLAG
CALL LBFLUSH ;No, flush current line
GO NXTCHR ]
CALL $GETCH ;[Justify mode] Get another character
CAIE 1,12 ;Bare <RETURN>?
GO CR3
CALL $GETCH ;Test for start of paragraph
CAR 0,A00(1) ;Special?
JUMPE 0,[ PUSH P,1 ;Save printing character
LACI 1," " ;Stuff space instead of return
CALL PUTCHR ;Put into buffer
POP P,1 ;Now do printer character
GO PUTCHR ]
CAIE 1,15
CAIN 1,12
GO [ CALL LBFLUSH
SETOM LFFLAG
GO NEWPAR ]
CAIN 1,11
GO [ TAB1: CAR 0,A00(1)
CALL @0
LAC 0,COL
DAC 0,TJLMAR
CALL $GETCH
CAIN 1,11
GO TAB1
GO GOTCHR ]
CAIN 1," "
GO [ SETOM CRFLAG
CALL LBFLUSH
SETOM LFFLAG
CR2: CAR 0,A00(1)
CAIN 1," "
GO CR4
CALL @0
CALL $GETCH
CR3: CAIN 1,15
GO CR2
CAIN 1,11
GO [ SETZM TJPTR
GO TAB1 ]
CAIE 1," "
GO GOTCHR
CR4: CALL PUTCHR
CALL $GETCH
GO CR3 ]
CAIE 1,14
CAIN 1,13
GO [ CALL LBFLUSH
CALL @0
SETOM LFFLAG
GO NEWPAR ]
CALL @0
GO NXTCHR
GO PUTCHR ]
CAIN 1,12
GO [ CALL LBFLUSH
SETOM LFFLAG
GO NXTCHR ]
CAIE 1,13
CAIN 1,14
GO [ CALL LBFLUSH
CALL @0
SETOM LFFLAG
GO NEWPAR ]
CAIN 1,11
GO [ CALL LBFLUSH
CAR 0,A00(1)
CALL @0
LAC 0,COL
DAC 0,TJLMAR
GO NXTCHR ]
CALL @0
GO NXTCHR
GO PUTCHR
LBLOSE: FATAL(LINE JUSTIFYING BUFFER FULL!)
DECLARE{↑TEXTPC}
BEND TEXT
SUBR LBLINE
BEGIN LBLINE
PTR←←16
MODE←←15
EXTRA←←14
PUSH P,1
PUSH P,EXTRA
PUSH P,PTR
PUSH P,MODE
PUSH P,CHAR
PUSH P,FONT
LAC MODE,TJMODE
LAC PTR,[POINT 7,LINBUF]
SETZM SPFLAG
SKIPN LFFLAG
GO LFOK
SETZM LFFLAG
LAC 1,TJDEPTH
CAMGE 1,TJODEPTH
LAC 1,TJODEPTH
ADD 1,TJHEIGTH
ADD 1,XLINE
ADDM 1,ROW
CALL ROWCHK
LFOK: SKIPE TJPTR
CAMN PTR,TJPTR
GO RET
SETOM TJSCNT ;Clear space count
SETZM TJSPOS ;Clear column of space
FNDSPA: CAMN PTR,TJPTR
GO [ LAC COL
DAC TJSPOS
GO GOTSPA ]
GOTSPA: DAC PTR,TJSPTR
LAC PTR,[POINT 7,LINBUF]
LAC EXTRA,TJRMAR
SUB EXTRA,TJSPOS
LAC 1,TJLMAR
EXCH 1,COL
CAMGE 1,TJRMAR
GO [ CAIN MODE,$BOTH
LAC MODE,$LEFT
GO .+1 ]
SETOM CRFLAG
LAC 1,TJPTR ;CLIP and AUTO use TJPTR instead of TJSPTR
SKIPE TJSPTR
CAIG MODE,$CLIP
DAC 1,TJSPTR
CAIN MODE,$CENTER
ASH EXTRA,-1
CAIE MODE,$RIGHT
CAIN MODE,$CENTER
ADDM EXTRA,COL
LOOP1: CAMN PTR,TJSPTR
GO LINDON
ILDB 1,PTR
CAIN 1,177
GO [ ILDB 1,PTR
CAIN 1,177
GO .+1
CAIL 1,20
GO [ FATAL(FONT NUMBER > 15.) ]
DAC 1,FONT
GO LOOP1 ]
CAIN 1," "
CAIE MODE,$BOTH
GO [ DAC 1,CHAR
CALL PRINT
GO LOOP1]
LAC 0,EXTRA
IDIV 0,TJSCNT
SOSGE TJSCNT
GO [ FATAL(SPACE COUNT SCREWED UP) ]
SUB EXTRA,0
LAC 1,FONT
SKIPN 1,FONTAB(1)
CALL NOFONT
CAR 1," "(1)
ADD 1,0
ADDM 1,COL
GO LOOP1
LINDON: LACI 1,5*LINLEN-2
DAC 1,TJCNT
LAC 1,COL
JUMPL MODE,LINDO2
CAMLE 1,TJRMAR
GO [ FATAL(COLUMN COUNT SCREWED UP!) ]
CAMN 1,TJRMAR
GO LINDO2
CAIE MODE,$BOTH
CAIN MODE,$RIGHT
GO [ FATAL(JUSTIFY LOST) ]
LINDO2: SKIPN CRFLAG
GO LINDO3
SETZM CRFLAG
LAC 1,LMAR
DAC 1,TJLMAR
DAC 1,COL
LINDO3: CAMN PTR,TJPTR
GO EMPTY
LAC EXTRA,PTR
LAC PTR,[POINT 7,LINBUF,6]
LAC 1,FONT
IDPB 1,PTR
SOS TJCNT
JUMPLE MODE,LOOP2
ILDB 1,EXTRA
CAIE 1," "
ADD EXTRA,[7B5] ;Decrement byte pointer!
LOOP2: CAMN EXTRA,TJPTR
GO MOVDON
ILDB 1,EXTRA
IDPB 1,PTR
SOS TJCNT
CAIE 1,177
GO CONT2
CAMN EXTRA,TJPTR
HALT .
ILDB 1,EXTRA
IDPB 1,PTR
SOS TJCNT
CAIN 1,177
GO CONT2
DAC 1,FONT
GO LOOP2
CONT2: LAC 2,FONT
SKIPN 2,FONTAB(2)
CALL NOFONT
ADD 2,1
CAR 2,(2)
ADDM 2,COL
GO LOOP2
EMPTY: LAC PTR,[POINT 7,LINBUF]
SETOM TJFONT
MOVDON: SETZM TJSPTR
SETOM TJSCNT
SETZM TJSPOS
DAC PTR,TJPTR
RET: POP P,FONT
POP P,CHAR
POP P,MODE
POP P,PTR
POP P,EXTRA
POP P,1
POP0J
DECLARE{SPFLAG}
BEND LBLINE
NOFONT: FATAL(NO FONT DEFINED)
LBFLUSH:LAC 0,COL
SKIPE TJMODE ;AUTO CLIP ALWAYS DOES ONE OUTPUT
CAMG 0,TJRMAR
GO [ LAC 0,TJMODE
CAIN 0,$BOTH
GO [ PUSH P,TJRMAR
LAC 0,COL
DAC 0,TJRMAR
CALL LBLINE
POP P,TJRMAR
SETOM LFFLAG
POP0J ]
GO LBLINE ]
CALL LBLINE
SETOM LFFLAG
GO LBFLUSH